perm filename VDSK.FAI[CMS,LCS]6 blob sn#424701 filedate 1979-03-10 generic text, type T, neo UTF8
00100	;Floppy disk file system.
00200	.INSERT ASMBL.FAI[CMS,LCS]
00300	   ZERO ← 0
00400	   LOC ZERO ;Fail offset
00500	
00600	CBLK:	0	;Ram command block.
00700	CCNT:	0	;C parameter count.
00800	CLEN:	0	;C # of sectors.
00900	CSEC:	0	;C sector
01000	CTRK:	0	;C track
01100		0
01200	FOTRK:	0	;Format track number.
01300		0
01400	FCMD:	0	;Disk command pointer.
01500	FCMDH:	0
01600	CMDJMP:	0	;Indirect command jump.
01700	CJMPH:	0	;Msbyte.
01800	BUSY:	0	;Busy flag.
01900	ERFLG:	0	;Error flag/code.
02000	SVERR:	0	;Saved error.
02100	CEFLG:	0	;Communication error flag.
02200	RFOPEN:	0	;Read file open flag.
02300	WFOPEN:	0	;Write file open flag
02400	DIRC:	0	;Data direction
02500	FLEN:	0	;File length. In sectors.
02600	FITRK:	0	;Compress file track.
02700	FISEC:	0	;Compress file sector.
02800	SREM:	0	;Sectors remaining.
02900	NTRYS:	0	;Number of retrys before error.
03000	MO:	0	;Motor on flag. MFLG = TL or TH?
03100	INDEX:	0	;State of index pin.
03200	TL:	0	;Motor time out low.
03300	TH:	0	;Time out high.
03400	DIRCNT:	0	;Directory sector count.
03500	HLEN:	0	;Hole sector count.
03600	HTRK:	0	;Hole track number.
03700	HSEC:	0	;Hole sector number.
03800	SVHY:	0	;Hole directory index. HDI.
03900	SVHSEC:	0	;Hole directory sector. HDS.
04000	SVSEC:	0	;Other directory sector. FDS.
04100	SVOSEC:	0	;Old directory sector.
04200	FDI:	0	;File directory index.
04300	FBLK:	0	;File block
04400	FNAME:	BLOCK 11	;9 Chr file name.
04500	NSEC:	0	;Number of sectors in file.
04600	FTRK:	0	;Disk track number
04700	FSEC:	0	;Disk sector number
04800		BLOCK 3	;For FBLK = 20.
04900	DBLK:	0	;Directory block
05000	DSEC:	0	;Number of sectors in directory.
05100	FFDIR:	0	;First free directory block. FDI?
05200	FFTRK:	0	;First free data track
05300	FFSEC:	0	;First free data sector
05400	FBLKS:	0	;Number of free sectors. In sectors.
05500	FBH:	0	;Msbyte
05600		0
05700	CKSUM:	0	;Check sum.
05800	SPOINT:	0	;SI/O pointer.
05900	SPOH:	0	;Msbyte
06000	DPOINT:	0	;Disk buffer bointer.
06100	DPOH:	0	;Msbyte
     

00100	OCTL:	0	;Lsbyte of octal to decimal.
00200	OCTH:	0	;Msbyte.
00300	DIGIT:	0	;Tens or hundreds.
00400	
00500	   LOC ZERO+1000
00600	FBUF:	0	;Disk data buffer.
00700	   LOC FBUF+400
00800	FBUF1:	0	;Other buffer.
00900	
01000	;PROM Start address.
01100	   LOC ZERO+174000
01200	FCTBL:
01300	   DINIT ← 0
01400		65	;Specify
01500		4	;Parameter count.
01600		352	;H unload I cnt./ H load time.
01700		=25	;Head settling time in ms*2.
01800		=20	;Step rate in ms*2.
01900		15	;Init
02000	   SBT ← 6
02100		65	;Specify
02200		4
02300		0	;Current track.
02400		377
02500		377	;No bad tracks.
02600		20	;Surface zero bad tracks command.
02700	   DMA ← 14
02800		172	;Write special register.
02900		2
03000		0	;DMA and double actuator.
03100		27	;Mode register.
03200	   RESTOR ← 20
03300		151	;Seek track zero command.
03400		1	;With head load.
03500		0	;Track zero
03600	   MON ← 23
03700		172	;Write special register.
03800		2	;Clear out pins.
03900		40	;Motor on bit.
04000		43	;Drive control output register.
04100	   MOFF ← 27
04200		172	;Write special register.
04300		2
04400		0	;Motor off.
04500		43	;Drive control output register.
04600	   RDSTAT ← 33
04700		154	;Read drive status command.
04800		0
04900	RH0:	123	;Read two sectors command.
05000		3
05100		2	;# of sectors.
05200		1	;Header sector number
05300		0	;Header track number
05400	WH0:	113	;Write two sectors command.
05500		3
05600		2	;# of sectors.
05700		1	;Header sector number.
05800		0	;Header track number.
     

00100	ID0:	113	;Write two sectors.
00200		3
00300		=16	;# of sectors.
00400		1	;First sector.
00500		0	;Track zero.
00600	FORMT:	143	;Format track command.
00700		5
00800		=16	;Gap 1 -6.
00900		0	;Gap 5. No index mark.
01000		=16	;Sectors per track.
01100		=27	;Gap 3 -6.
01200		0	;Format track number.
01300	
01400	   RETRY ← =10	;Number of retrys until error.
01500	   DMARK ← 74	;Directory mark
01600	   FMARK ← 72	;File mark
01700	   HMARK ← 67	;Hole mark.
     

00100	;Add restore to retry?
00200	;Add write protect and not ready error codes.
00300	;Put MOTOFF in GCHR?
00400	
00500	;Power on reset.
00600	RST:	LDXI	377	;Setup stack.
00700		TXS
00800		CLD	;Clear decimal mode.
00900	
01000	;Reset I/O
01100	   SIOC  ← 20000	;SI/O command register.
01200	   SIOD  ← 20001	;SI/O data register.
01300	   FDSKC ← 10000	;Disk command/status register
01400	   FDSKP ← 10001	;Disk parameter/result register
01500	   FDSKR ← 10002	;Disk reset register.
01600	   FDRQ  ← 14000	;Disk DMA data request
01700	
01800	;Init floppy disk controller.
01900		LDAI	1	;RESET DISK AGAIN.
02000	        STA     FDSKR
02100	        NOP
02200	        NOP
02300	        NOP
02400	        LSRA    ;A ← 0.
02500	        STA     FDSKR
02600	   ;A = DINIT.
02700		JSR	PCMD	;Prom command.
02800		LDAI	DMA	;Setup DMA mode.
02850		TAX	;X ← 14. For POW.
02900		JSR	PCMD
03000	
03100	        JSR     POW     ;POWER ON DELAY.
03200	
03300		LDAI	RESTOR	;Restore track zero.
03400		JSR	PCMD
03500		LDAI	SBT	;Setup bad tracks
03600		JSR	PCMD
03650		STYZ	MO	;Init motor on flag.
03700	;Reset SI/O
03800		LDAI	3	;Reset bits
03900		STA	SIOC
04000		LDAI	25	;ACIA control word.
04100		STA	SIOC
04200	
04300	;Init RAM
04400		LDAZ	DSEC
04500		STAZ	DIRCNT	;Point to end of directory.
     

00100	IDLSET:	LDAI	0
00200		LDXI	6	;Clear all error flags, etc.
00300	CLRF:	STAZX	BUSY
00400		DEX
00500		BPL	CLRF
00600	
00700		CLI	;Enable interrupts.
00800	
00900	   TWOS ← 5	;3 = 1.77s, 4 = 2.3s.
01000	IDLE:	BITZ	MO	;Check if motor on.
01100		BPL	GSOH
01200		LDA	SIOC	;Read SI/O status.
01300		LSRA	;Get rcvr. full bit.
01400		BCS	GSOH
01500	
01600		DEX	;Time out countdown.
01700		BNE	IDLE
01800		DECZ	TL
01900		BNE	IDLE
02000		DECZ	TH
02100		BNE	IDLE
02200	
02300		INX
02400		INCZ	TL
02500		INCZ	TH
02600		BITZ	BUSY	;Check if disk is busy.
02700		BMI	IDLE
02800		JSR	MOTOFF	;Turn off motor.
02900	
03000	GSOH:	JSR	GCHR	;Wait for SOH.
03100		CMPI	1	;<SOH>.
03200		BNE	ILLCMD	;Error.
03300		JSR	GCHR	;Wait for command.
     

00100	DCODE:	LDXI	NCMDS	;# of commands.
00200	DL:	CMPX	CMDTBL	;Check if valid command.
00300		BEQ	JCMD
00400		DEX
00500		BPL	DL
00600	;Illegal command.
00700	ILLCMD:	LDXI	4	;Command error code.
00800	OCLR:	JSR	OCHR	;Output status.
00900		JMP	IDLSET	;Reset flags.
01000	
01100	JCMD:	LDAX	JLTBL	;Get lsbyte of jump address.
01200		STAZ	CMDJMP
01300		LDAX	JHTBL	;Get msbyte.
01400		STAZ	CJMPH
01500	
01600		JMPIN	CMDJMP	;Excute command.
01700	
01800	   NCMDS ← =9	;# of commands -1.
01900	CMDTBL:	"P"	;Perform special function.
02000		"K"	;Delete file.
02100		"B"	;Free blocks
02200		"N"	;Next directory block.
02300		"D"	;Open directory.
02400		"C"	;Close write file.
02500		"E"	;Enter write file.
02600		"O"	;Open read file.
02700		"W"	;Write data
02800		"R"	;Read data
02900	
03000	JLTBL:	PSF∧377	;Lsbyte of command address.
03100		KIL∧377
03200		BLKS∧377
03300		NXTDIR∧377
03400		DIR∧377
03500		CLOZE∧377
03600		ENTR∧377
03700		OPIN∧377
03800		WRITE∧377
03900		READ∧377
04000	
04100	JHTBL:	PSF⊗-10	;Msbyte of command address.
04200		KIL⊗-10
04300		BLKS⊗-10
04400		NXTDIR⊗-10
04500		DIR⊗-10
04600		CLOZE⊗-10
04700		ENTR⊗-10
04800		OPIN⊗-10
04900		WRITE⊗-10
05000		READ⊗-10
     

00100	;Write command to FDSKC. No wait or * NTRYS.
00200	PCMD:	STAZ	FCMD	;Prom command with no retrys.
00300		LDAI	370	;Msbyte of command table addr.
00400		STAZ	FCMDH
00500		LDAI	0
00600		STAZ	NTRYS
00700		BEQ	SETPO	;Jump.
00800	
00900	RCMD:	LDAI	0	;Ram command with no retrys.
01000	SETRY:	STAZ	NTRYS
01100	TRY:	LDAI	0
01200		STAZ	FCMD
01300		STAZ	FCMDH
01400	
01500		LDAI	377	;Set busy.
01600		STAZ	BUSY
01700		LDAI	0
01800	SETPO:	STAZ	DPOINT	;Reset disk DMA pointer.
01900	
02000	BSYW:	LDA	FDSKC	;Wait until not busy.
02100		BMI	BSYW
02200	
02300		LDYI	0
02400		LDAIY	FCMD	;Get command code.
02500		STA	FDSKC	;Write in disk control reg.
02600	
02700		INCZ	FCMD	;Point to parameter count.
02800		LDAIY	FCMD	;Get count.
02900		BEQ	NOPAR	;If no parameters
03000		TAY
03100	
03200	PARW:	LDA	FDSKC	;Read status
03300		ANDI	40	;P reg full bit.
03400		BNE	PARW	;Wait if still full.
03500	
03600		LDAIY	FCMD	;Parameter
03700		STA	FDSKP
03800		DEY
03900		BNE	PARW	;More left?
04000	
04100	NOPAR:	RTS	;Y = 0
04200	
04300	WBUFR:	LDAI	113	;Write two sectors command.
04400		STAZ	CBLK
04500	WUF:	LDAI	377
04600		STAZ	DIRC	;Set to write.
04700	
04800	;Disk command with retrys on read error.
04900	RCMDR:	LDAI	RETRY	;RAM disk command.
05000		BNE	SETRY
05100	
05200	RCMDW:	JSR	RCMDR	;Read command wait.
05300	BW:	BITZ	BUSY
05400		BMI	BW	;Wait until done
05500		LDAZ	ERFLG	;Get error bits.
05600		RTS	;Return with error bits.
     

00100	;IRQ maskable interrupt routine.
00200	IRQV:	PHA	;Save Registers.
00300		TYA
00400		PHA
00500	   ;Wait for result bit?
00600		LDA	FDSKP	;Read disk result register.
00700		ANDI	36	;Flush ddbit
00800		STAZ	ERFLG
00900	
01000		LDYI	200
01100	CKIRQ:	INY	;IRQ reset delay.
01200		BNE	CKIRQ
01300	
01400		TAY	;Test error flags.
01500		BNE	DSKERR	;Disk error.
01600		LDAZ	CBLK	;Get last disk command.
01700		CMPI	113	;Check if write command.
01800		BNE	NOTBSY
01900	
02000		LDAI	137	;Disk verify command.
02100		STAZ	CBLK
02200		BNE	ITRY	;Verify write.
02300	
02400	DSKERR:	ANDI	20	;Bad bit
02500		BEQ	CKTRY
02600	;Dsk error: RDY,WRT fault, etc.
02700	;Fix for WPRT etc.
02800		STAZ	SVERR	;Save bad error.
02900	;Read drive status if not ready for clear.
03000	   ;Check if not ready?
03100		JSR	RDRVST	;Read dirve status.
03200	;Error codes before RDRVST.
03300	;20 Not ready.
03400	;21 Write protect.
03500	;22 Restore error.
03600	;23 File not found.
03700	;30 Sector not found.
03800		JMP	NOTBSY
03900	
04000	CKTRY:	LDAZ	NTRYS
04100		BEQ	SETERR
04200		
04300		DECZ	NTRYS
04400	ITRY:	JSR	TRY	;Retry command.
04500		BEQ	RTRN	;Jump. Wait until done.
04600	
04700	SETERR:	LDAI	377	;Retry error.
04800		STAZ	SVERR
04900	
05000	NOTBSY:	LDAI	0
05100		STAZ	BUSY	;Set done
05200		STAZ	DIRC	;Reset to read.
05300		BEQ	RTRN	;Jump.
     

00100	;Non-maskable DRQ interrupt.
00200	NMIV:	PHA	;Save registers
00300		TYA
00400		PHA
00500		LDYI	0	;No index.
00600	
00700		BITZ	DIRC	;Get direction.
00800		BMI	WDRQ	;Disk write.
00900	
01000		LDA	FDRQ	;Read byte from disk.
01100		STAIY	DPOINT	;Save it in FBUF
01200	
01300	INCPO:	INCZ	DPOINT
01400	
01500	RTRN:	PLA	;Restore Registers.
01600		TAY
01700		PLA
01800		RTI	;Return
01900	
02000	WDRQ:	LDAIY	DPOINT	;Get byte from FBUF.
02100		STA	FDRQ	;Write into disk data register.
02200		JMP	INCPO
     

00100	;Directory look up.
00200	;Returns with file found, fnf, or read error.(0,200,XX)
00300	LOKUP:	LDXI	0
00400	GNAME:	JSR	GCHR	;Get name.
00500		CMPI	4	;<EOT>.
00600		BEQ	CKNAME
00700		STAZX	FNAME
00800		INX
00900		CPXI	=10	;9 Chr file name + EOT.
01000		BCC	GNAME
01100	ILCJMP:	PLA	;One level pop to ILLCMD.
01200		PLA
01300		JMP	ILLCMD
01400	
01500	CKNAME:	TXA	;Test X.
01600		BEQ	ILCJMP	;No file name.
01700		LDAI	" "	;<Space>.
01800	PAD:	STAZX	FNAME	;Pad file name with spaces.
01900		INX
02000		CPXI	=9
02100		BCC	PAD
02200		LDAZ	CEFLG	;Check for communication error.
02300		BNE	ILCJMP
02400		JSR	RHDR	;Read directory header sector.
02500		BNE	LUERR
02600		LDAI	FMARK
02700		STAZ	FBLK
02800	
02900	GETS:	JSR	RNDS	;Read next 2 directory sectors.
03000		BNE	LUERR
03100			;Y = 0
03200	CKDIR:	LDXI	0
03300	CKNAM:	LDAY	FBUF
03400		CMPZX	FBLK	;Look for file name.
03500		BNE	NXTF	;No match
03600		INY
03700		INX
03800		CPXI	=10	;9 chrs. + FMARK.
03900		BCC	CKNAM
04000	;Names match
04100	FMOV:	LDAY	FBUF	;Save file record.
04200		STAZX	FBLK
04300		INY
04400		INX
04500		CPXI	20
04600		BCC	FMOV
04700	
04800		LDAI	0	;Return with file found.
04900	LUERR:	RTS	;Return with error bits.
05000	
05100	NXTF:	TYA	;Point to next file record.
05200		ORAI	17
05300		TAY
05400		INY
05500		BNE	CKDIR
05600	
05700		DECZ	SREM	;Check if more sectors.
05800		DECZ	SREM
05900		BNE	GETS
06000		LDAI	200	;Return file not found code.
06100		RTS
     

00100	;Read 1st sec of a directory. Returns with 0 or Ebits.
00200	RHDR:	JSR	MOTON	;Turn on motor and delay.
00300		LDXI	4
00400	CSET:	LDAX	RH0	;Setup command list.
00500		STAZX	CBLK
00600		DEX
00700		BPL	CSET
00800	
00900		JSR	SETDPO	;Point disk to FBUF.
01000		JSR	RSEC	;Read it * 16.
01100		BNE	HERR
01200		LDA	FBUF
01300		CMPI	DMARK	;Check for directory.
01400		BNE	HERR	;Fix for if DMARK≠FBUF=0.
01500	
01600		LDXI	7
01700	GHL:	LDAX	FBUF
01800		STAZX	DBLK
01900		DEX
02000		BPL	GHL
02100		LDAZ	DSEC
02200		STAZ	SREM	;Number of sectors in dir.
02300		STAZ	DIRCNT	;Reset directory count.
02400		LDAI	0	;No error return
02500	HERR:	RTS	;Return with error bits.
02600	
02700	;Read next dir. sector. Returns with error bits.
02800	RNDS:	INCZ	CSEC	;Read next dir sec.
02900		INCZ	CSEC
03000	;Read a block routine.
03100	REED:	LDAI	123	;Read two sectors command.
03200		STAZ	CBLK
03300	RSEC:	LDAI	0	;Reset file open flags.
03400		STAZ	RFOPEN
03500		STAZ	WFOPEN
03600	
03700		JSR	RCMDW	;Disk command wait * RETRYS
03800		BEQ	GOTIT	;Good read
03900		INY	;Y ← 1. Directory 1.
04000		STYZ	CTRK
04100		JSR	RCMDW	;Y ← 0
04200		STYZ	CTRK	;Fix CTRK for next read.
04300	GOTIT:	RTS	;Return with error bits.
04400	
04500	SETDPO:	LDAI	FBUF⊗-10	;Point disk to FBUF.
04600		STAZ	DPOH
04700		LDAI	0
04800		STAZ	DPOINT
04900		RTS
05000	
05100	INCSEC:	INX	;Increment sector and track address.
05200		INX
05300		CPXI	=16
05400		BCC	NXTBLK
05500		ADCI	0	;TRK ← TRK + 1.
05600		LDXI	1	;First sector.
05700	NXTBLK:	RTS
     

00100	;Open read file.
00200	OPIN:	BITZ	WFOPEN	;Check if write file open.
00300		BPL	LOOK
00400		JMP	FAO	;File already open error.
00500	
00600	LOOK:	JSR	LOKUP	;Lookup file FNAM
00700		BEQ	SETOPN
00800		CMPI	200	;File not found code.
00900		BEQ	NACKIT
01000		JMP	DIRERR	;Directory read error
01100	NACKIT:	JMP	FNF	;File not found.
01200	
01300	SETOPN:	LDAZ	FTRK	;Get track and sector
01400		STAZ	CTRK
01500		LDAZ	FSEC
01600		STAZ	CSEC
01700		LDAZ	NSEC	;Get file length.
01800		STAZ	SREM
01900	;Fill FBUF
02000		JSR	RCMDR	;* NTRYS and no wait.
02100	
02200		JSR	SETSPO	;Point SPOINT to FBUF.
02300		LDAI	377
02400		STAZ	RFOPEN
02500	
02600	ACK:	LDXI	20	;<ack>
02700	OACK:	JSR	OCHR	;Output byte.
02800		JMP	IDLE	;No flag clear.
02900	
03000	SETSPO:	LDAI	FBUF⊗-10	;Reset SI/O pointer.
03100		STAZ	SPOH
03200		LDAI	0
03300		STAZ	SPOINT
03400		RTS
     

00100	;Read a block of the file.
00200	READ:	JSR	GEOT	;Wait for EOT.
00300		BITZ	RFOPEN	;Check if file open.
00400		BMI	CKS
00500		JMP	FNF	;File not found
00600	CKS:	LDAZ	SREM	;Check for end of file.
00700		BNE	READO	;For FLEN = 0.
00800	EOF:	LDXI	6	;End of file error code.
00900		JMP	OCLR	;Output X and clear flags.
01000	
01100	READO:	JSR	BW	;Wait until not busy.
01200		BEQ	NXTBUF
01300	DRERR:	LDXI	14	;Disk read error.
01400		JMP	OCLR	;Clear all flags.
01500	
01600	NXTBUF:	STAZ	CKSUM
01700		DECZ	SREM	;Check if end of file.
01800		DECZ	SREM
01900		BEQ	ACKIT
02000	   ;Start read of next buffer.
02100		JSR	NXTSEC	;Increment CSEC and CTRK.
02200	
02300	RNS:	JSR	SWDBUF	;Swap disk buffers.
02400		JSR	MOTON	;Turn on motor.
02500		JSR	RCMDR	;No wait. Y=0. Set CBLK?
02600	ACKIT:	JSR	ACKSTX	;Output <ack> and <stx>.
02700			;Y = 0
02800	RDIT:	LDAIY	SPOINT	;Output a buffer full.
02900		JSR	OCHECK	;Output byte and update check sum.
03000		INY
03100		BNE	RDIT
03200	
03300		JSR	SWSBUF	;Swap SI/O buffers.
03400	OUTCK:	LDAZ	CKSUM	;Output check sum.
03500		EORI	377
03600		TAX
03700		INX
03800		JMP	OACK	;Output it and no flag clear.
03900	
04000	SWSBUF:	LDAZ	SPOH
04100		EORI	1	;Swap SI/O buffers.
04200		STAZ	SPOH
04300		RTS
     

00100	;Create file routine
00200	ENTR:	BITZ	WFOPEN	;Check if file already open
00300		BPL	LOKIT
00400	FAO:	LDXI	10	;File already open error.
00500		BNE	OAJMP	;Output it. No flag clear.
00600	LOKIT:	JSR	LOKUP	;Check if file already exists.
00700		BEQ	FEXIST	;Check if file exists
00800		CMPI	200	;Not in dir. code
00900		BEQ	FULCK	;If = then Y = 0.
01000	DIRERR:	LDXI	13	;Directory read error code.
01100	CLRJMP:	JMP	OCLR	;Clear flags.
01200	
01300	FEXIST:	LDXI	2	;File exists error code.
01400		BNE	CLRJMP	;Clear flags.
01500	
01600	DSKFUL:	LDAI	=35	;Disk full.
01700		STAZ	FFTRK	;Set full flag.
01800	DFUL:	LDXI	5	;Disk full code.
01900	OAJMP:	JMP	OACK	;No flag clear?
02000	
02100	FULCK:	LDAZ	FFTRK	;Get first free track.
02200		CMPI	=35	;Check if disk full.
02300		BCS	DFUL
02400	
02500		STAZ	CTRK	;Point to new file.
02600		STAZ	FTRK	;Setup file block.
02700		STAZ	CLEN	;Track number for seek.
02800		LDAI	151	;Seek track command.
02900		STAZ	CBLK
03000		INY	;Y ← 1.
03100		STYZ	CCNT
03200	
03300		JSR	RCMD	;Seek track. Y = 0
03400		STYZ	FLEN	;Reset file length.
03500	
03600		DEY	;Set write file open flag.
03700		STYZ	WFOPEN
03800	
03900		LDXI	3	;Setup command parameter count.
04000		STXZ	CCNT
04100		STXZ	DPOH	;Point disk to other buffer.
04200		DEX	;Setup number of sectors.
04300		STXZ	CLEN
04400		LDXZ	FFSEC
04500		STXZ	FSEC	;Setup file block.
04600		DEX	;-2 For inc. before write.
04700		DEX
04800		STXZ	CSEC
04900	
05000		JSR	SETSPO	;Point SI/O to FBUF.
05100		JMP	ACK	;Return with no errors
     

00100	;Write file.
00200	WRITE:	JSR	GEOT	;Wait for EOT.
00300		BITZ	WFOPEN	;Check if file open.
00400		BMI	WIT
00500		JMP	FNF	;File not found
00600	WIT:	LDAZ	FFTRK
00700		CMPI	=35	;Check if disk is full.
00800		BCS	DSKFUL
00900	
01000		JSR	PACK	;Output <ACK>.
01100		JSR	GCHR	;Wait for STX.
01200		CMPI	2	;<STX>.
01300		BNE	COMERR	;No STX.
01400	
01500		LDYI	0	;Init buffer index.
01600		STYZ	CKSUM	;Init check sum.
01700	
01800	WLOOP:	JSR	GCHR	;Fill FBUF.
01900		STAIY	SPOINT
02000		CLC
02100		ADCZ	CKSUM	;Update check sum.
02200		STAZ	CKSUM
02300		INY
02400		BNE	WLOOP
02500	
02600		JSR	GCHR	;Get check sum.
02700		CLC
02800		ADCZ	CKSUM	;Check for check sum error.
02900		BNE	COMERR
03000		LDAZ	CEFLG	;Check for communication error.
03100		BEQ	WBUF
03200	COMERR:	LDXI	11	;Communication error.
03300		JMP	OCLR	;Reset flags.
03400	
03500	WBUF:	JSR	BW	;Wait until last buffer done.
03600		BEQ	NFBLK
03700		JMP	DRERR	;Write error. Verify error?
03800	NFBLK:	JSR	NXTSEC	;Increment CSEC and CTRK.
03900		CMPI	=35	;Check if disk is full.
04000		BCC	SWBUF
04100		JMP	DSKFUL
     

00100	SWBUF:	JSR	SWDBUF	;Swap disk buffers.
00200		JSR	MOTON	;Turn on motor.
00300		JSR	WBUFR	;Write buffer.
00400		
00500		JSR	SWSBUF	;Swap SI/O buffers.
00600		INCZ	FLEN	;Update file length.
00700		INCZ	FLEN
00800		JMP	ACK	;No error return.
00900	
01000	WBUFW:	JSR	WBUFR	;Write it.
01100		JMP	BW	;Return with E bits when done.
01200	
01300	SWDBUF:	LDAZ	DPOH
01400		EORI	1	;Swap disk buffers.
01500		STAZ	DPOH
01600		RTS
01700	
01800	NXTSEC:	LDXZ	CSEC	;Increment CSEC and CTRK.
01900		LDAZ	CTRK
02000		JSR	INCSEC
02100		STXZ	CSEC
02200		STAZ	CTRK
02300		RTS
     

00100	CLOZE:	JSR	GEOT	;Wait for EOT.
00200		BITZ	WFOPEN	;Check if file open
00300		BMI	UPDIR
00400		JMP	ACKCLR	;No file open, <ack> anyway.
00500	
00600	;Update directory
00700	UPDIR:	JSR	BW	;Wait until not busy.
00800		BEQ	BUMP
00900		JMP	DRERR	;Last buffer write error?
01000	
01100	BUMP:	LDAZ	FLEN	;Save file length.
01200		STAZ	NSEC
01300		JSR	NXTSEC	;Get new FFSEC and FFTRK.
01400		STAZ	HTRK
01500		STXZ	HSEC
01600	
01700	;Read last directory sector.
01800		JSR	MOTON	;Turn on motor.
01900	
02000		LDXZ	DSEC	;Last directory sector -1.
02100		INX	;Bump.
02200		STXZ	CSEC
02300		STXZ	SVOSEC	;Save last dir. sec. number.
02400		JSR	SETDPO	;Point to FBUF. A ← 0
02500		STAZ	CTRK	;Track zero.
02600		JSR	REED	;Read next dir. sec.
02700		BEQ	CLOZIT
02800	CLZERR:	JMP	DIRERR	;Directory read error.
02900	
03000	CLOZIT:	LDYZ	FFDIR
03100	
03200		TAX	;X ← 0
03300	NAMEIT:	LDAZX	FBLK	;BLT FBLK into directory
03400		STAY	FBUF
03500		INY
03600		INX
03700		CPXI	20	;FBLK Length
03800		BCC	NAMEIT
     

00100	;Update directory header.
00200	WRTH0:	TYA	;Get next free directory block.
00300		STAZ	FFDIR
00400		BNE	UPFF
00500		INCZ	DSEC	;Next sector
00600		INCZ	DSEC
00700		LDAZ	DSEC	;Check if directory full.
00800		CMPI	=15
00900		BCC	UPFF
01000		LDAI	=14	;Last directory sector.
01100		STAZ	DSEC
01200		LDAI	=35	;Set disk full.
01300		STAZ	HTRK
01400	UPFF:	LDAZ	HSEC	;Point to next free block.
01500		STAZ	FFSEC
01600		LDAZ	HTRK
01700		STAZ	FFTRK
01800		SEC
01900		LDAZ	FBLKS
02000		SBCZ	FLEN	;Update free blocks.
02100		STAZ	FBLKS
02200		BCS	WDIR
02300		DECZ	FBH
02400	WDIR:	LDXI	7	;Header length.
02500	HLOOP:	LDAZX	DBLK	;BLT Header into directory.
02600		STAX	FBUF1	;Other buffer.
02700		DEX
02800		BPL	HLOOP
02900	
03000		LDAI	1	;First sector.
03100		STAZ	SVSEC
03200		JSR	WBUFS	;Write 4 bufs on 2 tracks.
03300		BNE	CLZERR	;Check for close error.
03400		STAZ	WFOPEN	;Close write open flag.
03500	ACKCLR:	LDXI	20	;<Ack>.
03600		JMP	OCLR	;Output <Ack> and clear flags.
03700	
03800	   ;Add error checks after WBUFWs?
03900	WBUFS:	JSR	WBUFW	;Write dir. 0.
04000	
04100		LDAZ	SVSEC	;First sector.
04200		STAZ	CSEC
04300		JSR	SWDBUF	;Swap disk buffers.
04400	
04500		JSR	WBUFW	;Write dir. header 0. Y←0
04600		INY	;Y ← 1. Directory 1.
04700		STYZ	CTRK
04800		JSR	WBUFW	;Write dir. header 1.
04900	   ;Write last track directory.
05000		LDAZ	SVOSEC	;Get last dir.sec. number.
05100		STAZ	CSEC
05200		JSR	SWDBUF	;Swap buffers.
05300		JSR	WBUFW
05400	
05500		LDAZ	SVERR	;?
05600		RTS	;Return with error bits.
     

00100	PSF:	JSR	GEOT
00200		JSR	PACK	;<Ack>
00300		JSR	GCHR	;Wait for SOH.
00400		CMPI	1	;SOH
00500		BNE	PSFERR
00600		JSR	GCHR	;Wait for special function cmd.
00700		CMPI	"Q"	;Compress holes.
00800		BNE	CKF
00900		JSR	GEOT	;Wait for EOT.
01000		JMP	CMPRES
01100	
01200	CKF:	CMPI	"F"	;Format disk.
01300		BNE	CKI
01400		JMP	FORM
01500	CKI:	CMPI	"I"	;Initialize directory.
01600		BEQ	IDIR
01700	PSFERR:	JMP	ILLCMD	;Command error.
01800	;Initialize directory.
01900	IDIR:	JSR	GEOT	;Wait for EOT.
02000		JSR	MOTON	;Turn on motor.
02100	FORMIN:	LDXI	10	;Entry from format command.
02200		LDAI	0
02300	ZE:	STAX	FBUF	;Zero directory
02400		INX
02500		BNE	ZE
02600		LDXI	7
02700	DIIL:	LDAX	DIT	;Init dir.
02800		STAX	FBUF
02900		DEX
03000		BPL	DIIL
03100	
03200		LDXI	4
03300	SETC:	LDAX	ID0	;Setup CBLK.
03400		STAZX	CBLK
03500		DEX
03600		BPL	SETC
03700	
03800		JSR	SETDPO	;Point disk to FBUF.
03900		JSR	WS2TRK	;Write sector on two tracks.
04000		BNE	IDERR
04100		JMP	ACKCLR	;<Ack> and clear flags.
04200	
04300	IDERR:	LDXI	7	;Init dir. error.
04400		JMP	OCLR	;Reset flags.
04500	
04600	WS2TRK:	JSR	WBUFW	;Write first header and dir.
04700		INY	;Y←1. Directory 1.
04800		STYZ	CTRK
04900		JSR	WBUFW	;Write last directory.
05000		LDAZ	SVERR	;Return with all errors.
05100		RTS
05200	
05300	DIT:	DMARK
05400		2	;# of sectors
05500		0	;FFDB
05600		2	;FFT
05700		1	;FFS
05800		=528∧377	;FBL
05900		=528⊗-10	;FBH
06000		0
     

00100	;Delete file.
00200	KIL:	JSR	LOKUP
00300		BEQ	KILIT
00400	   ;Check for directory read error?
00500	FNF:	LDXI	3	;File not found.
00600		JMP	OCLR
00700	KILIT:	DEY	;Fix directory pointer.
00800		LDAI	HMARK
00900		STAY	761	;FBUF - 17
01000		LDXZ	CSEC
01100		STXZ	SVOSEC	;Save directory sector #.
01200		INY	;Next directory block.
01300		CPYZ	FFDIR	;Check if last dir. block.
01400		BNE	DEL
01500		DEX
01600		TYA	;A ← Old FFDIR.
01700		BNE	CKSEC
01800		INX
01900		INX
02000	CKSEC:	CPXZ	DSEC	;Check if last block in dir.
02100		BNE	DEL
02200		SEC	;File = last file in dir.
02300		SBCI	20	;Point to FFDIR -1 block.
02400		STAZ	FFDIR
02500		TAX
02600		LDAI	0
02700		STAX	FBUF	;Null record entry.
02800		LDAZ	FTRK	;Point first free track to
02900		STAZ	FFTRK	;deleted file.
03000		LDAZ	FSEC
03100		STAZ	FFSEC
03200		CLC
03300		LDAZ	FBLKS
03400		ADCZ	NSEC	;Add # of sectors in file
03500		STAZ	FBLKS	;to free block count.
03600		BCC	CKDSEC
03700		INCZ	FBH
03800	
03900	CKDSEC:	TYA	;Test Y.
04000		BNE	DEL
04100		DECZ	DSEC	;Directory sector -2.
04200		DECZ	DSEC
04300	
04400	DEL:	JMP	WDIR	;Write header and directory.
04500	
04600	;Output free blocks.
04700	BLKS:	JSR	GEOT	;Wait for EOT.
04800		JSR	RHDR	;Read directory header.
04900		BNE	JDER	;Directory read error.
05000		JSR	ACKSTX	;Output <ack> and <stx>.
05100		LDAZ	FBH	;Get msbyte of free blocks.
05200		LDXZ	FBLKS	;Get lsbyte.
05300		JSR	ODEC	;Output 3 decimal digits.
05400	OEOT:	LDXI	4	;<EOT>.
05500		JMP	OCLR	;Clear flags.
     

00100	DIR:	JSR	GEOT	;Wait for EOT.
00200		JSR	RHDR	;Read header.
00300		BEQ	RQDIR
00400	JDER:	JMP	DIRERR	;Error.
00500	RQDIR:	STAZ	DIRCNT	;Point to start. A = 0.
00600	JACK:	JMP	ACKCLR	;<Ack> and clear flags.
00700	
00800	NXTDIR:	JSR	GEOT	;Wait for EOT.
00900		LDXZ	DIRCNT	;Check if at end.
01000		CPXZ	DSEC	;Check if done.
01100		BCC	NXD
01200		JMP	EOF
01300	NXD:	INX
01400		INX
01500		STXZ	DIRCNT	;Update directory count.
01600		INX	;Bump past dir. header.
01700		STXZ	CSEC
01800		JSR	MOTON	;Turn on motor.
01900		JSR	RSEC	;Read next directory sector.
02000		BNE	JDER
02100		JSR	ACKSTX	;Output <ACK> and <stx>.
02200		LDAI	160	;((15+12)*=16)∧377.
02300		STAZ	CKSUM	;Init check sum.
02400			;Y = 0
02500	DOL:	LDAY	FBUF	;Find file in FBUF.
02600		CMPI	FMARK
02700		BNE	OUTZ
02800		LDXI	11	;9 Chr file name.
02900		STXZ	HSEC
03000	
03100	ONAME:	LDXY	1001	;FBUF + 1.
03200	        JSR	OCHRCK	;Output it.
03300		INY
03400		DECZ	HSEC
03500		BNE	ONAME
03600		LDXI	" "	;Output two spaces.
03700		JSR	OCHRCK	;Output and update check sum.
03800		JSR	OCHRCK	;Output and update check sum.
03900		LDAI	0	;Msbyte of file length.
04000		LDXY	1001	;Get lsbyte from FBUF.
04100		JSR	ODEC	;Output 3 ascii decimal digits.
04200	
04300	CLOUT:	LDXI	15	;<CR>.
04400		JSR	OCHR
04500		LDXI	12	;<LF>.
04600		JSR	OCHR
04700		TYA
04800		ORAI	17	;Next file block.
04900		TAY
05000		INY
05100		BNE	DOL
05200		JMP	OUTCK	;Output check sum.
05300	
05400	OUTZ:	LDAI	16	;9 chr. file name + 5.
05500		STAZ	HSEC
05600		LDXI	0	;Null file block. (Hole)
05700	ZOUT:	JSR	OCHR	;Output nulls.
05800		DECZ	HSEC
05900		BNE	ZOUT
06000		BEQ	CLOUT	;Jump.
     

00100	;Compress holes.
00200	CMPRES:	JSR	RHDR	;Read directory header.
00300		BNE	DJ
00400	SQEZ:	JSR	RNDS	;Read directory.
00500		BNE	DJ
00600			;Y = 0
00700	ENDCK:	LDXZ	CSEC	;Check if at end of dir.
00800		DEX	;Unbump.
00900		CPXZ	DSEC	;Check if same sector.
01000		BCC	CKHOL
01100		CPYZ	FFDIR	;Check if less that last record.
01200		BCC	CKHOL
01300		JMP	ACKCLR	;Done.
01400	CKHOL:	LDAY	FBUF	;Find first hole.
01500		CMPI	HMARK	;Look for a hole.
01600		BEQ	HOLE
01700		TYA
01800		CLC
01900		ADCI	20	;Next directory record.
02000		TAY
02100		BNE	ENDCK
02200		BEQ	SQEZ	;Jump.
02300	DJ:	JMP	DIRERR	;Directory read error.
02400	;Hole found.
02500	HOLE:	LDAY	1013	;FBUF + TRK#
02600		STAZ	HTRK	;Save hole track.
02700		LDAY	1014	;FBUF + SEC#
02800		STAZ	HSEC	;Save hole sector.
02900		STYZ	SVHY	;Save hole dir. index.
03000		LDAZ	CSEC
03100		STAZ	SVHSEC	;Save hole dir. sector.
03200	FINDF:	CLC	;Update free blocks.
03300		LDAZ	FBLKS
03400		ADCY	1012	;FBUF + FLEN.
03500		STAZ	FBLKS
03600		BCC	FNXTF
03700		INCZ	FBH
03800	FNXTF:	TYA	;Find next file.
03900		CLC
04000		ADCI	20	;Next dir. record.
04100		TAY
04200		BNE	CKEND
04300	
04400		JSR	RNDS	;Read next directory block.
04500		BNE	DJ	;Error.
04600			;Y = 0.
04700	CKEND:	LDXZ	CSEC
04800		DEX	;Unbump.
04900		CPXZ	DSEC	;Check if last dir. sector.
05000		BCC	CKFIL
05100		CPYZ	FFDIR	;Check if past last record.
05200		BCC	CKFIL
05300		JMP	DONE
05400	CKFIL:	LDAY	FBUF	;Look for file mark.
05500		CMPI	FMARK
05600		BEQ	FFOUND
05700		CMPI	HMARK	;Check if a hole.
05800		BNE	FNXTF
05900		BEQ	FINDF	;Jump and add hole length.
     

00100	   ;File found. Save file address.
00200	;FBUF ← File directory.
00300	FFOUND:	STYZ	FDI	;Save file directory index.
00400		INX	;Save file directory sector #.
00500		STXZ	SVSEC	;SVSEC ← FDS.
00600		LDXI	0
00700		JSR	FMOV	;Save FBLK. Y ← Y + 20.
00800		JSR	SWDBUF	;Swap disk buffers.
00900		LDAZ	NSEC	;Get file length.
01000		STAZ	FLEN
01100		LDAZ	FTRK	;Get file address.
01200		LDXZ	FSEC
01300		LDYZ	HTRK	;Save next file address.
01400		STYZ	FTRK
01500		LDYZ	HSEC
01600		STYZ	FSEC
01700	;Fill hole.
01800	FILLIT:	STAZ	FITRK	;Save file track.
01900		STXZ	FISEC	;Save file sector.
02000		STAZ	CTRK
02100		STXZ	CSEC
02200		LDAI	123	;Read two sectors command.
02300		STAZ	CBLK
02400		JSR	RCMDW	;Read a block.
02500		BNE	DJMP
02600	
02700		LDAZ	HTRK	;Point to hole.
02800		STAZ	CTRK
02900		LDXZ	HSEC
03000		STXZ	CSEC
03100		JSR	INCSEC	;Increment hole address.
03200		STAZ	HTRK	;New FFTRK.
03300		STXZ	HSEC	;New FFSEC.
03400		JSR	WBUFW	;Fill hole.
03500		BNE	DJMP
03600	
03700		DECZ	FLEN	;FLEN ← FLEN - 2.
03800		DECZ	FLEN
03900		BEQ	CUPD	;Check if hole filled.
04000		LDXZ	FISEC
04100		LDAZ	FITRK
04200		JSR	INCSEC	;Next file sectors.
04300		BNE	FILLIT	;Jump.
04400	;Update directory.
04500	CUPD:	LDAZ	SVHSEC	;Read HDS into FBUF1.
04600		STAZ	CSEC	;Get hole dir. sector.
04700		STAZ	SVOSEC	;Save other sector number for WBUFS.
04800		LDAI	0	;Track zero.
04900		STAZ	CTRK
05000		JSR	REED	;Read hole dir. sector.
05100		BEQ	FIXDIR
05200	DJMP:	JMP	DIRERR	;Directory read error.
     

00100	FIXDIR:	CLV	;V ← 0.
00200		LDAZ	SVSEC	;Check if FDS = HDS.
00300		CMPZ	SVOSEC
00400		BEQ	ZEROX
00500		BIT	CKDUPE	;V ← 1. M6.
00600	ZEROX:	LDXI	0
00700		LDYZ	SVHY	;Get hole dir. index.
00800	UPBLK:	LDAZX	FBLK	;FBUF1 ← FBLK.
00900		STAY	FBUF1	;Other buffer.
01000		BVS	NXTXY	;If FDS = HDS...
01100		STAY	FBUF	;write into other buffer too.
01200	NXTXY:	INY
01300		INX
01400		CPXI	20	;FBLK length.
01500		BCC	UPBLK
01600	;Find next file.
01700		TYA	;Get HDI.
01800		STAZ	SVHY	;Next hole directory index.
01900		BNE	MARKIT
02000		INCZ	SVHSEC	;Next hole directory sector.
02100		INCZ	SVHSEC
02200	MARKIT:	LDYZ	FDI	;Update old file record.
02300		LDAI	0	;0 = Not FMARK or HMARK.
02400		STAY	FBUF	;Old file ← empty record.
02500		BVS	DIFFS	;Check if HDS = FDS.
02600		STAY	FBUF1	;Mark other buffer too.
02700		JSR	WS2TRK	;Write sector on two tracks.
02800		JMP	CKDUPE
02900	DIFFS:	JSR	WBUFS	;Write 4 bufs on 2 tracks.
03000	CKDUPE:	BNE	DJMP
03100		JSR	SETDPO	;Point disk to FBUF.
03200		STAZ	CTRK	;CTRK ← 0.
03300		LDAZ	SVSEC	;FDS
03400		STAZ	CSEC
03500		LDYZ	FDI	;Get file dir index.
03600		JMP	FNXTF	;Find next file.
03700	DONE:	LDAZ	HTRK	;FFDT ← next hole track.
03800		STAZ	FFTRK	;Update first free data track.
03900		LDAZ	HSEC	;FFDS ← nezt hole sector.
04000		STAZ	FFSEC	;Update first free data sector.
04100		LDYZ	SVHY	;Get first free dir. block.
04200		STYZ	FFDIR
04300		LDXZ	SVHSEC
04400		DEX	;Unbump.
04500		STXZ	DSEC	;Update directory sector count.
04600		LDXI	7
04700	BLTIT:	LDAZX	DBLK	;BLT Header into directory.
04800		STAX	FBUF
04900		DEX
05000		BPL	BLTIT
05100		INX	;X ← 0.
05200		STXZ	CTRK	;Point to directory track.
05300		INX	;X ← 1.
05400		STXZ	CSEC	;Header sector.
05500		JSR	WS2TRK	;Write two sectors on two tracks.
05600		BNE	UPERR	;Write error.
05700		JMP	ACKCLR	;Packed.
05800	UPERR:	JMP	DIRERR	;?
     

00100	FORM:	JSR	GEOT
00200		JSR	MOTON	;Turn on motor.
00300	
00400		JSR	SETDPO	;Point to FBUF.
00500		LDXI	6
00600	CSLOP:	LDAX	FORMT	;Setup command list.
00700		STAZX	CBLK
00800		DEX
00900		BPL	CSLOP
01000	
01100	TKOOP:	LDXI	1	;First sector.
01200		LDYI	0
01300	SCOOP:	LDAZ	FOTRK	;Get track number.
01400		STAY	FBUF	;And setup I.D.s.
01500		INY
01600		LDAI	0
01700		STAY	FBUF	;Head number.
01800		INY
01900		TXA
02000		STAY	FBUF	;Sector number.
02100		INY
02200		LDAI	0
02300		STAY	FBUF	;Length.
02400		INY
02500		INX	;Next sector.
02600		CPXI	=17	;Sectors per track +1.
02700		BCC	SCOOP
02800	
02900		JSR	WUF	;Write buffer.
03000		JSR	BW	;Wait until not busy.
03100	   ;Add verify 16 sectors? Check disk error?
03200		INCZ	FOTRK	;Next track.
03300		LDAZ	FOTRK
03400		CMPI	=35
03500		BCC	TKOOP
03600	
03700		LDAZ	SVERR	;Check for errors?
03800		BNE	UPERR	;Error.
03900		JMP	FORMIN	;Init directory.
04000	;Wait for input.
04100	GCHR:	LDA	SIOC	;Read SI/O status.
04200		LSRA	;Get rcvr. full bit.
04300		BCC	GCHR
04400		ANDI	30	;FE, OVR.
04500		BNE	CERR
04600		LDA	SIOD	;Input byte.
04700		RTS
04800	CERR:	STAZ	CEFLG	;Save comm. error.
04900		LDA	SIOD	;Read data reg. to reset error.
05000		LDAI	0	;Return with null?
05100		RTS
05200	
05300	GEOT:	JSR	GCHR	;Wait for EOT.
05400		CMPI	4	;<EOT>
05500		BNE	TERR
05600		LDAZ	CEFLG	;Check for comm. error.
05700		BNE	TERR	;Jump to comerr?
05800		RTS
05900	TERR:	JMP	ILCJMP	;Pop up one level to ILLCMD.
     

00100	;Decimal output routine.
00200	ODEC:	CLC
00300		RORA	;/2
00400		STAZ	OCTH
00500		TXA
00600		RORA
00700		STAZ	OCTL
00800		LDAI	=100
00900		JSR	GDIG	;Output hundreds.
01000		LDAI	=10
01100		JSR	GDIG	;Output tens.
01200		LDAZ	OCTL
01300		ORAI	60	;Convert to ascii.
01400	OCHECK:	TAX
01500	
01600	OCHRCK:	TXA
01700		CLC
01800		ADCZ	CKSUM	;Update check sum.
01900		STAZ	CKSUM
02000	;Output byte in X.
02100	OCHR:	LDA	SIOC	;Read SI/O status.
02200		ANDI	2	;Transmiter full bit.
02300		BEQ	OCHR
02400		STX	SIOD	;Output it.
02500		RTS
02600	PACK:	LDXI	20	;Output <ack>.
02700		BNE	OCHR
02800	ACKSTX:	JSR	PACK	;Output <ack> and <stx>.
02900	PSTX:	LDXI	2	;Output <stx>.
03000		BNE	OCHR
03100	
03200	RDRVST:	LDAI	RDSTAT	;Read drive status command.
03300		JSR	PCMD
03400	SW:	LDA	FDSKC	;Read drive status.
03500		BMI	SW	;Wait until not busy.
03600		LDA	FDSKP	;Get result.
03700		ANDI	20	;Index bit.
03800		RTS
     

00100	MOTOFF:	LDAI	MOFF	;Turn motor off.
00200		JSR	PCMD
00300		STYZ	MO	;MO ← 0.
00400		RTS
00500	
00600	   ONES ← =13	;=10 = 1s?
00700	MOTON:	LDXZ	MO	;Check if already on.
00800		BNE	SPUN
00900		STXZ	TL	;Setup timer. X = 0, MO = 0.
01000		LDAI	MON	;Turn it on.
01100		JSR	PCMD
01200	
01300	POW:    LDAI    ONES
01400	        STAZ    TH
01500	
01600		JSR	RDRVST	;Get index bit.
01700		STAZ	INDEX
01800	
01900	MW:	JSR	RDRVST	;Check for index.
02000		EORZ	INDEX
02100		BEQ	CNTDWN	;Check if same as last index.
02200		INX	;Count the index.
02300		EORZ	INDEX	;Get new index.
02400		STAZ	INDEX
02500	
02600	CNTDWN:	DECZ	TL	;Motor on delay.
02700		BNE	MW
02800		DECZ	TH
02900		BNE	MW
03000	
03050		LDAI	377
03100		CPXI	3	;Check if disk is spining.
03200		BCS	SPIN
03250		TAX
03275		TXS	;SP ← 377. Fix stack.
03300		JSR	MOTOFF
03500		LDXI	12	;Drive not ready error.
03600		JMP	OCLR
03700	
03800	SPIN:	STAZ	MO	;Set motor on flag.
04000	SPUN:	LDAI	TWOS
04100		STAZ	TH
04200		RTS
     

00100	GDIG:	STAZ	DIGIT
00200		LDXI	57	;"0" -1.
00300	DIGLOP:	INX
00400		SEC
00500		LDAZ	OCTL
00600		SBCZ	DIGIT
00700		STAZ	OCTL
00800		BCS	DIGLOP
00900		DECZ	OCTH
01000		BPL	DIGLOP
01100		LDAZ	OCTL
01200		ADCZ	DIGIT	;C = 0.
01300		STAZ	OCTL
01400		INCZ	OCTH
01500		JMP	OCHRCK	;Output digit and update check sum.
01600	
01700	;Reset and interrupt vectors.
01800	   LOC ZERO + 177772
01900		NMIV∧377	;NMI Vector.
02000		NMIV⊗-10
02100		RST∧377	;Reset vector.
02200		RST⊗-10
02300		IRQV∧377	;IRQ Vector.
02400		IRQV⊗-10
02500	END